home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / basics / tuples.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.6 KB  |  97 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2.  
  3. (* TUPLES and Tuples should be called RECORDS and Records, since records are the
  4.    primary concept, and tuples are a derived form. *)
  5.  
  6. signature TUPLES = sig
  7.   structure Types : TYPES
  8.   val numlabel : int -> Types.label
  9.   val mkTUPLEtyc : int -> Types.tycon
  10.   val isTUPLEtyc : Types.tycon -> bool
  11.   val mkRECORDtyc : Types.label list -> Types.tycon
  12. end
  13.  
  14. structure Tuples : TUPLES = struct
  15.  
  16. structure Types = Types
  17.  
  18. open Types
  19.  
  20. datatype labelOpt = NOlabel | SOMElabel of label
  21. datatype tyconOpt = NOtycon | SOMEtycon of tycon
  22.  
  23. structure LabelArray =
  24.     Dynamic (struct open Array
  25.            type array = labelOpt array
  26.            type elem = labelOpt
  27.          end)
  28.  
  29. structure TyconArray =
  30.     Dynamic (struct open Array
  31.            type array = tyconOpt array
  32.            type elem = tyconOpt
  33.          end)
  34.  
  35. exception New
  36. val tyconTable = IntStrMap.new(32,New) : tycon IntStrMap.intstrmap
  37. val tyconMap = IntStrMap.map tyconTable
  38. val tyconAdd = IntStrMap.add tyconTable
  39.  
  40. fun labelsToSymbol(labels: label list) : Symbol.symbol =
  41.     let fun wrap [] = ["}"]
  42.       | wrap [id] = [Symbol.name id, "}"]
  43.       | wrap (id::rest) = Symbol.name id :: "," :: wrap rest
  44.      in Symbol.tycSymbol(implode("{" :: wrap labels))
  45.     end
  46.  
  47. (* this is an optimization to make similar record tycs point to the same thing,
  48.     thus speeding equality testing on them *)
  49. fun mkRECORDtyc labels = 
  50.     let val recordName = labelsToSymbol labels
  51.         val number = Symbol.number recordName
  52.         val name = Symbol.name recordName
  53.      in tyconMap(number,name)
  54.     handle New =>
  55.       let val tycon = RECORDtyc labels
  56.        in tyconAdd(number,name,tycon);
  57.           tycon
  58.       end
  59.     end
  60.  
  61. val numericLabels = LabelArray.array(NOlabel)
  62. val tupleTycons = TyconArray.array(NOtycon)
  63.  
  64. fun numlabel i =
  65.     case LabelArray.sub(numericLabels,i)
  66.       of NOlabel =>
  67.        let val newlabel = Symbol.labSymbol(makestring i)
  68.         in LabelArray.update(numericLabels,i,SOMElabel(newlabel));
  69.            newlabel
  70.        end
  71.        | SOMElabel(label) => label
  72.  
  73. fun numlabels n =
  74.     let fun labels (0,acc) = acc
  75.       | labels (i,acc) = labels (i-1, numlabel i :: acc)
  76.     in labels (n,nil)
  77.     end
  78.  
  79. fun mkTUPLEtyc n =
  80.     case TyconArray.sub(tupleTycons,n)
  81.       of NOtycon =>
  82.            let val tycon = mkRECORDtyc(numlabels n)
  83.         in TyconArray.update(tupleTycons,n,SOMEtycon(tycon));
  84.            tycon
  85.        end
  86.        | SOMEtycon(tycon) => tycon
  87.  
  88. fun checklabels (2,nil) = false   (* {1:t} is not a tuple *)
  89.   | checklabels (n,nil) = true
  90.   | checklabels (n, lab::labs) = 
  91.     Symbol.eq(lab, numlabel n) andalso checklabels(n+1,labs)
  92.  
  93. fun isTUPLEtyc(RECORDtyc labels) = checklabels(1,labels)
  94.   | isTUPLEtyc _ = false
  95.     
  96. end (* structure Tuples *)
  97.